home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
borland
/
jnfb88.zip
/
KEYINT.ZIP
/
ACCEL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-10-08
|
8KB
|
253 lines
PROGRAM Accel;
USES Crt,Dos;
(* ======================================= *)
(* This program demonstrates a method for *)
(* accelerating the motion of an arrow-key *)
(* controlled character on the screen. *)
(* If a "direction" key is held down, the *)
(* character moves in larger and larger *)
(* jumps, up to a preset "Speed Limit". *)
(* It's easy to set the SPEED back down to *)
(* 1 whenever a new direction is chosen -- *)
(* the catch is to reset it when the *)
(* SAME direction key is RELEASED. *)
(* ======================================= *)
{=============}
{BEGIN INCLUDE}
{=============}
CONST
KR : Boolean = False;{KeyReleased FLAG}
Kbd_Int = 9;
VAR
Kbd_Vec, Exit_Vec : Pointer;
{$I ERROR.INC}
PROCEDURE CLI; INLINE($FA); {INLINE procedures are NICE!}
PROCEDURE STI; INLINE($FB);
PROCEDURE INT9_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
_SI, _DI, _DS, _ES, _BP:word);
INTERRUPT;
(* ======================================== *)
(* This procedure gets ahead of the normal *)
(* interrupt 9 and checks if the current *)
(* character is a KEYPRESS code or a KEY *)
(* RELEASE -- if the latter, the typed *)
(* constant "KR" is set to TRUE (= 1). *)
(* ======================================== *)
BEGIN
Inline(
$9C/ {PUSHF ;Save flags}
$E4/$60/ {IN AL,$60 ;Read the keyboard port}
$A8/$80/ {TEST AL,$80 ;Is the high bit set?}
$74/$05/ {JZ Press ;If not, skip to "Press"}
$C6/$06/>KR/$01/ {MOV BYTE PTR [>KR],+$01 ;If so, make KR TRUE}
{Press:}
(* ============================ *)
(* CHAIN to the regular INT 9 *)
(* ============================ *)
$9D/ {POPF ;Restore the flags}
$A1/>KBD_VEC+2/ {MOV AX,[>KBD_VEC+2] ;Old vector seg to AX}
$8B/$1E/>KBD_VEC/ {MOV BX,[>KBD_VEC] ;Old vector ofs to BX}
$87/$5E/$0E/ {XCHG BX,[BP+$0E] ;Swap ofs w/ return address}
$87/$46/$10/ {XCHG AX,[BP+$10] ;Swap seg w/ return address}
$89/$EC/ {MOV SP,BP ;UNDO procedure's entry code}
$5D/ {POP BP}
$07/ {POP ES}
$1F/ {POP DS}
$5F/ {POP DI}
$5E/ {POP SI}
$5A/ {POP DX}
$59/ {POP CX}
$CB); {RETF ;in effect, JMP to old vector}
END;
FUNCTION KeyReleased : Boolean;
(* ================================ *)
(* Returns the state of the flag *)
(* KR and resets it to FALSE *)
(* ================================ *)
BEGIN
CLI; {Don't want it changing DURING this!}
KeyReleased := KR;
KR := False;
STI; {OK, can change now}
END;
{=============}
{END INCLUDE }
{=============}
PROCEDURE Do_Demo;
(* ======================================== *)
(* Here begins the DEMO procedure that uses *)
(* the ISR above. It responds to the four *)
(* arrows keys and to "U", "A", and "Q". *)
(* Move around with the arrow keys for a *)
(* while, and then hit "A" to engage the *)
(* Accellator. "U" will Unaccelerate the *)
(* arrow keys, and "Q" is the signal to *)
(* Quit. *)
(* ======================================== *)
CONST
UKey = #72; {SCAN codes for the arrow keys}
DKey = #80;
LKey = #75;
RKey = #77;
TYPE
direction = (Up, Down, Left, Right);
VAR
CRow, CCol : Byte;
accel : Boolean;
CH, CH2, Last_Arrow : Char;
M, Speed : Byte;
CONST
Speed_Limit = 8;
Mark = #$E9;{theta character}
unmark = #$20;{space character}
Arrows : SET OF Char = [UKey, DKey, LKey, RKey];
PROCEDURE RevVideo;
BEGIN
TextColor(Black);
TextBackground(White);
END;
PROCEDURE initialize;
BEGIN
TextBackground(black);
ClrScr;
RevVideo;
Write(' MOVE with 4 arrow keys.');
Write(' [A]ccel, [U]naccel, [Q]uit.');
Write(' Speed: ');
TextBackground(Black);
TextColor(White);
Speed := 1;
CRow := 12;
CCol := 40;
Last_Arrow := #0;
Accel := False;
END;
PROCEDURE PutAChar(co, ro, fore, back : Byte; CH : char);
(* ===================================== *)
(* At location (co,ro), write character *)
(* CH with color specified by the fore- *)
(* and background attributes. *)
(* ===================================== *)
BEGIN
TextColor(fore);
TextBackground(back);
GoToXY(co, ro);
Write(CH);
END;
PROCEDURE Move_Increment(D : direction);
(* ======================================= *)
(* Move the marker in the given direction *)
(* by as many spaces as the current SPEED. *)
(* If we hit the edge, beep and set speed *)
(* back to one. *)
(* ======================================= *)
PROCEDURE beep;
BEGIN
Sound(1000); Delay(50);
Sound(2000); Delay(50);
NoSound;
END;
BEGIN
{FIRST blank the old location }
PutAChar(CCol, CRow, white, black, unmark);
CASE D OF
Up : CRow := CRow-1;
Down : CRow := CRow+1;
Left : CCol := CCol-1;
Right : CCol := CCol+1;
END;
IF CRow < 2 THEN
BEGIN CRow := 2; speed := 1; beep; END;
IF CRow > 24 THEN
BEGIN CRow := 24; speed := 1; beep; END;
IF CCol < 1 THEN
BEGIN CCol := 1; speed := 1; beep; END;
IF CCol > 80 THEN
BEGIN CCol := 80; speed := 1; beep; END;
{NOW mark the new location }
PutAChar(CCol, CRow, black, white, Mark);
END;
BEGIN {procedure Do_Demo;}
Initialize;
PutAChar(CCol, CRow, black, white, Mark);
REPEAT
REPEAT
CH := #0; CH2 := #0;
REPEAT UNTIL KeyPressed OR KeyReleased;
IF KeyPressed THEN
BEGIN
CH := ReadKey;
IF (CH = #0) AND KeyPressed THEN
CH2 := ReadKey
ELSE CH := UpCase(CH);
END
ELSE {A key was released}
speed := 0;
UNTIL ((CH IN ['A', 'U', 'Q']) OR (CH2 IN Arrows));
IF CH = #0 THEN
BEGIN
IF Accel THEN
IF CH2 = Last_Arrow THEN
BEGIN
{Key CH2 is being held down --
increase speed!}
IF Speed < Speed_Limit THEN
Speed := Speed+1;
END
ELSE Speed := 1
ELSE Speed := 1;
GoToXY(79, 1); Write(speed);
Last_Arrow := CH2;
CASE CH2 OF
UKey : FOR M := 1 TO speed DO
Move_Increment(Up);
DKey : FOR M := 1 TO speed DO
Move_Increment(Down);
LKey : FOR M := 1 TO speed DO
Move_Increment(Left);
RKey : FOR M := 1 TO speed DO
Move_Increment(Right);
END;
END
ELSE
CASE CH OF
'A' : BEGIN
Accel := True;
RevVideo;
TextColor(Black+Blink);
GoToXY(59, 1); Write('ACCELERATED');
END;
'U' : BEGIN
Accel := False;
RevVideo;
GoToXY(59, 1); Write(' ');
END;
'Q' : ;
END;
UNTIL CH = 'Q';
END;
BEGIN
CheckBreak := TRUE;
GetIntVec(Kbd_Int, Kbd_Vec); {save "old" INT9}
SetIntVec(Kbd_Int, @INT9_ISR); {install new}
Exit_Vec := ExitProc; {save old ExitProc}
ExitProc := @My_Error; {install new}
Do_Demo; {show yer stuff!}
{The interrupt vector gets RESTORED in the ExitProc}
EN